home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / win / tclWinChan.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  31.2 KB  |  1,182 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclWinChan.c
  3.  *
  4.  *    Channel drivers for Windows channels based on files, command
  5.  *    pipes and TCP sockets.
  6.  *
  7.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclWinChan.c 1.74 97/06/20 13:06:00
  13.  */
  14.  
  15. #include "tclWinInt.h"
  16.  
  17. /*
  18.  * This is the size of the channel name for File based channels
  19.  */
  20.  
  21. #define CHANNEL_NAME_SIZE    64
  22. static char channelName[CHANNEL_NAME_SIZE+1];
  23.  
  24. /*
  25.  * The following variable is used to tell whether this module has been
  26.  * initialized.
  27.  */
  28.  
  29. static int initialized = 0;
  30.  
  31. /*
  32.  * State flags used in the info structures below.
  33.  */
  34.  
  35. #define FILE_PENDING    (1<<0)    /* Message is pending in the queue. */
  36. #define FILE_ASYNC    (1<<1)    /* Channel is non-blocking. */
  37. #define FILE_APPEND    (1<<2)    /* File is in append mode. */
  38.  
  39. /*
  40.  * The following structure contains per-instance data for a file based channel.
  41.  */
  42.  
  43. typedef struct FileInfo {
  44.     Tcl_Channel channel;    /* Pointer to channel structure. */
  45.     int validMask;        /* OR'ed combination of TCL_READABLE,
  46.                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  47.                  * which operations are valid on the file. */
  48.     int watchMask;        /* OR'ed combination of TCL_READABLE,
  49.                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  50.                  * which events should be reported. */
  51.     int flags;            /* State flags, see above for a list. */
  52.     HANDLE handle;        /* Input/output file. */
  53.     struct FileInfo *nextPtr;    /* Pointer to next registered file. */
  54. } FileInfo;
  55.  
  56. /*
  57.  * List of all file channels currently open.
  58.  */
  59.  
  60. static FileInfo *firstFilePtr;
  61.  
  62. /*
  63.  * The following structure is what is added to the Tcl event queue when
  64.  * file events are generated.
  65.  */
  66.  
  67. typedef struct FileEvent {
  68.     Tcl_Event header;        /* Information that is standard for
  69.                  * all events. */
  70.     FileInfo *infoPtr;        /* Pointer to file info structure.  Note
  71.                  * that we still have to verify that the
  72.                  * file exists before dereferencing this
  73.                  * pointer. */
  74. } FileEvent;
  75.  
  76. /*
  77.  * Static routines for this file:
  78.  */
  79.  
  80. static int        ComGetOptionProc _ANSI_ARGS_((ClientData instanceData, 
  81.                 Tcl_Interp *interp, char *optionName,
  82.                 Tcl_DString *dsPtr));
  83. static int        ComInputProc _ANSI_ARGS_((ClientData instanceData,
  84.                         char *buf, int toRead, int *errorCode));
  85. static int        ComSetOptionProc _ANSI_ARGS_((ClientData instanceData,
  86.                 Tcl_Interp *interp, char *optionName, 
  87.                 char *value));
  88. static int        FileBlockProc _ANSI_ARGS_((ClientData instanceData,
  89.                 int mode));
  90. static void        FileChannelExitHandler _ANSI_ARGS_((
  91.                     ClientData clientData));
  92. static void        FileCheckProc _ANSI_ARGS_((ClientData clientData,
  93.                 int flags));
  94. static int        FileCloseProc _ANSI_ARGS_((ClientData instanceData,
  95.                     Tcl_Interp *interp));
  96. static int        FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr, 
  97.                 int flags));
  98. static int        FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
  99.                     int direction, ClientData *handlePtr));
  100. static void        FileInit _ANSI_ARGS_((void));
  101. static int        FileInputProc _ANSI_ARGS_((ClientData instanceData,
  102.                         char *buf, int toRead, int *errorCode));
  103. static int        FileOutputProc _ANSI_ARGS_((ClientData instanceData,
  104.                 char *buf, int toWrite, int *errorCode));
  105. static int        FileSeekProc _ANSI_ARGS_((ClientData instanceData,
  106.                 long offset, int mode, int *errorCode));
  107. static void        FileSetupProc _ANSI_ARGS_((ClientData clientData,
  108.                 int flags));
  109. static void        FileWatchProc _ANSI_ARGS_((ClientData instanceData,
  110.                     int mask));
  111.  
  112.                 
  113. /*
  114.  * This structure describes the channel type structure for file based IO.
  115.  */
  116.  
  117. static Tcl_ChannelType fileChannelType = {
  118.     "file",            /* Type name. */
  119.     FileBlockProc,        /* Set blocking or non-blocking mode.*/
  120.     FileCloseProc,        /* Close proc. */
  121.     FileInputProc,        /* Input proc. */
  122.     FileOutputProc,        /* Output proc. */
  123.     FileSeekProc,        /* Seek proc. */
  124.     NULL,            /* Set option proc. */
  125.     NULL,            /* Get option proc. */
  126.     FileWatchProc,        /* Set up the notifier to watch the channel. */
  127.     FileGetHandleProc,        /* Get an OS handle from channel. */
  128. };
  129.  
  130. static Tcl_ChannelType comChannelType = {
  131.     "com",            /* Type name. */
  132.     FileBlockProc,        /* Set blocking or non-blocking mode.*/
  133.     FileCloseProc,        /* Close proc. */
  134.     ComInputProc,        /* Input proc. */
  135.     FileOutputProc,        /* Output proc. */
  136.     NULL,            /* Seek proc. */
  137.     ComSetOptionProc,        /* Set option proc. */
  138.     ComGetOptionProc,        /* Get option proc. */
  139.     FileWatchProc,        /* Set up notifier to watch the channel. */
  140.     FileGetHandleProc        /* Get an OS handle from channel. */
  141. };
  142.  
  143. /*
  144.  *----------------------------------------------------------------------
  145.  *
  146.  * FileInit --
  147.  *
  148.  *    This function creates the window used to simulate file events.
  149.  *
  150.  * Results:
  151.  *    None.
  152.  *
  153.  * Side effects:
  154.  *    Creates a new window and creates an exit handler. 
  155.  *
  156.  *----------------------------------------------------------------------
  157.  */
  158.  
  159. static void
  160. FileInit()
  161. {
  162.     initialized = 1;
  163.     firstFilePtr = NULL;
  164.     Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
  165.     Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
  166. }
  167.  
  168. /*
  169.  *----------------------------------------------------------------------
  170.  *
  171.  * FileChannelExitHandler --
  172.  *
  173.  *    This function is called to cleanup the channel driver before
  174.  *    Tcl is unloaded.
  175.  *
  176.  * Results:
  177.  *    None.
  178.  *
  179.  * Side effects:
  180.  *    Destroys the communication window.
  181.  *
  182.  *----------------------------------------------------------------------
  183.  */
  184.  
  185. static void
  186. FileChannelExitHandler(clientData)
  187.     ClientData clientData;    /* Old window proc */
  188. {
  189.     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
  190.     initialized = 0;
  191. }
  192.  
  193. /*
  194.  *----------------------------------------------------------------------
  195.  *
  196.  * FileSetupProc --
  197.  *
  198.  *    This procedure is invoked before Tcl_DoOneEvent blocks waiting
  199.  *    for an event.
  200.  *
  201.  * Results:
  202.  *    None.
  203.  *
  204.  * Side effects:
  205.  *    Adjusts the block time if needed.
  206.  *
  207.  *----------------------------------------------------------------------
  208.  */
  209.  
  210. void
  211. FileSetupProc(data, flags)
  212.     ClientData data;        /* Not used. */
  213.     int flags;            /* Event flags as passed to Tcl_DoOneEvent. */
  214. {
  215.     FileInfo *infoPtr;
  216.     Tcl_Time blockTime = { 0, 0 };
  217.  
  218.     if (!(flags & TCL_FILE_EVENTS)) {
  219.     return;
  220.     }
  221.     
  222.     /*
  223.      * Check to see if there is a ready file.  If so, poll.
  224.      */
  225.  
  226.     for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  227.     if (infoPtr->watchMask) {
  228.         Tcl_SetMaxBlockTime(&blockTime);
  229.         break;
  230.     }
  231.     }
  232. }
  233.  
  234. /*
  235.  *----------------------------------------------------------------------
  236.  *
  237.  * FileCheckProc --
  238.  *
  239.  *    This procedure is called by Tcl_DoOneEvent to check the file
  240.  *    event source for events. 
  241.  *
  242.  * Results:
  243.  *    None.
  244.  *
  245.  * Side effects:
  246.  *    May queue an event.
  247.  *
  248.  *----------------------------------------------------------------------
  249.  */
  250.  
  251. static void
  252. FileCheckProc(data, flags)
  253.     ClientData data;        /* Not used. */
  254.     int flags;            /* Event flags as passed to Tcl_DoOneEvent. */
  255. {
  256.     FileEvent *evPtr;
  257.     FileInfo *infoPtr;
  258.  
  259.     if (!(flags & TCL_FILE_EVENTS)) {
  260.     return;
  261.     }
  262.     
  263.     /*
  264.      * Queue events for any ready files that don't already have events
  265.      * queued (caused by persistent states that won't generate WinSock
  266.      * events).
  267.      */
  268.  
  269.     for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  270.     if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
  271.         infoPtr->flags |= FILE_PENDING;
  272.         evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
  273.         evPtr->header.proc = FileEventProc;
  274.         evPtr->infoPtr = infoPtr;
  275.         Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
  276.     }
  277.     }
  278. }
  279.  
  280. /*----------------------------------------------------------------------
  281.  *
  282.  * FileEventProc --
  283.  *
  284.  *    This function is invoked by Tcl_ServiceEvent when a file event
  285.  *    reaches the front of the event queue.  This procedure invokes
  286.  *    Tcl_NotifyChannel on the file.
  287.  *
  288.  * Results:
  289.  *    Returns 1 if the event was handled, meaning it should be removed
  290.  *    from the queue.  Returns 0 if the event was not handled, meaning
  291.  *    it should stay on the queue.  The only time the event isn't
  292.  *    handled is if the TCL_FILE_EVENTS flag bit isn't set.
  293.  *
  294.  * Side effects:
  295.  *    Whatever the notifier callback does.
  296.  *
  297.  *----------------------------------------------------------------------
  298.  */
  299.  
  300. static int
  301. FileEventProc(evPtr, flags)
  302.     Tcl_Event *evPtr;        /* Event to service. */
  303.     int flags;            /* Flags that indicate what events to
  304.                  * handle, such as TCL_FILE_EVENTS. */
  305. {
  306.     FileEvent *fileEvPtr = (FileEvent *)evPtr;
  307.     FileInfo *infoPtr;
  308.  
  309.     if (!(flags & TCL_FILE_EVENTS)) {
  310.     return 0;
  311.     }
  312.  
  313.     /*
  314.      * Search through the list of watched files for the one whose handle
  315.      * matches the event.  We do this rather than simply dereferencing
  316.      * the handle in the event so that files can be deleted while the
  317.      * event is in the queue.
  318.      */
  319.  
  320.     for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  321.     if (fileEvPtr->infoPtr == infoPtr) {
  322.         infoPtr->flags &= ~(FILE_PENDING);
  323.         Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
  324.         break;
  325.     }
  326.     }
  327.     return 1;
  328. }
  329.  
  330. /*
  331.  *----------------------------------------------------------------------
  332.  *
  333.  * FileBlockProc --
  334.  *
  335.  *    Set blocking or non-blocking mode on channel.
  336.  *
  337.  * Results:
  338.  *    0 if successful, errno when failed.
  339.  *
  340.  * Side effects:
  341.  *    Sets the device into blocking or non-blocking mode.
  342.  *
  343.  *----------------------------------------------------------------------
  344.  */
  345.  
  346. static int
  347. FileBlockProc(instanceData, mode)
  348.     ClientData instanceData;    /* Instance data for channel. */
  349.     int mode;            /* TCL_MODE_BLOCKING or
  350.                                  * TCL_MODE_NONBLOCKING. */
  351. {
  352.     FileInfo *infoPtr = (FileInfo *) instanceData;
  353.     
  354.     /*
  355.      * Files on Windows can not be switched between blocking and nonblocking,
  356.      * hence we have to emulate the behavior. This is done in the input
  357.      * function by checking against a bit in the state. We set or unset the
  358.      * bit here to cause the input function to emulate the correct behavior.
  359.      */
  360.  
  361.     if (mode == TCL_MODE_NONBLOCKING) {
  362.     infoPtr->flags |= FILE_ASYNC;
  363.     } else {
  364.     infoPtr->flags &= ~(FILE_ASYNC);
  365.     }
  366.     return 0;
  367. }
  368.  
  369. /*
  370.  *----------------------------------------------------------------------
  371.  *
  372.  * FileCloseProc --
  373.  *
  374.  *    Closes the IO channel.
  375.  *
  376.  * Results:
  377.  *    0 if successful, the value of errno if failed.
  378.  *
  379.  * Side effects:
  380.  *    Closes the physical channel
  381.  *
  382.  *----------------------------------------------------------------------
  383.  */
  384.  
  385. static int
  386. FileCloseProc(instanceData, interp)
  387.     ClientData instanceData;    /* Pointer to FileInfo structure. */
  388.     Tcl_Interp *interp;        /* Not used. */
  389. {
  390.     FileInfo *fileInfoPtr = (FileInfo *) instanceData;
  391.     FileInfo **nextPtrPtr;
  392.     int errorCode = 0;
  393.  
  394.     /*
  395.      * Remove the file from the watch list.
  396.      */
  397.  
  398.     FileWatchProc(instanceData, 0);
  399.  
  400.     if (CloseHandle(fileInfoPtr->handle) == FALSE) {
  401.     TclWinConvertError(GetLastError());
  402.     errorCode = errno;
  403.     }
  404.     for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
  405.      nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
  406.     if ((*nextPtrPtr) == fileInfoPtr) {
  407.         (*nextPtrPtr) = fileInfoPtr->nextPtr;
  408.         break;
  409.     }
  410.     }
  411.     ckfree((char *)fileInfoPtr);
  412.     return errorCode;
  413. }
  414.  
  415. /*
  416.  *----------------------------------------------------------------------
  417.  *
  418.  * FileSeekProc --
  419.  *
  420.  *    Seeks on a file-based channel. Returns the new position.
  421.  *
  422.  * Results:
  423.  *    -1 if failed, the new position if successful. If failed, it
  424.  *    also sets *errorCodePtr to the error code.
  425.  *
  426.  * Side effects:
  427.  *    Moves the location at which the channel will be accessed in
  428.  *    future operations.
  429.  *
  430.  *----------------------------------------------------------------------
  431.  */
  432.  
  433. static int
  434. FileSeekProc(instanceData, offset, mode, errorCodePtr)
  435.     ClientData instanceData;            /* File state. */
  436.     long offset;                /* Offset to seek to. */
  437.     int mode;                    /* Relative to where
  438.                                                  * should we seek? */
  439.     int *errorCodePtr;                /* To store error code. */
  440. {
  441.     FileInfo *infoPtr = (FileInfo *) instanceData;
  442.     DWORD moveMethod;
  443.     DWORD newPos;
  444.  
  445.     *errorCodePtr = 0;
  446.     if (mode == SEEK_SET) {
  447.         moveMethod = FILE_BEGIN;
  448.     } else if (mode == SEEK_CUR) {
  449.         moveMethod = FILE_CURRENT;
  450.     } else {
  451.         moveMethod = FILE_END;
  452.     }
  453.  
  454.     newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
  455.     if (newPos == 0xFFFFFFFF) {
  456.         TclWinConvertError(GetLastError());
  457.         return -1;
  458.     }
  459.     return newPos;
  460. }
  461.  
  462. /*
  463.  *----------------------------------------------------------------------
  464.  *
  465.  * FileInputProc --
  466.  *
  467.  *    Reads input from the IO channel into the buffer given. Returns
  468.  *    count of how many bytes were actually read, and an error indication.
  469.  *
  470.  * Results:
  471.  *    A count of how many bytes were read is returned and an error
  472.  *    indication is returned in an output argument.
  473.  *
  474.  * Side effects:
  475.  *    Reads input from the actual channel.
  476.  *
  477.  *----------------------------------------------------------------------
  478.  */
  479.  
  480. static int
  481. FileInputProc(instanceData, buf, bufSize, errorCode)
  482.     ClientData instanceData;        /* File state. */
  483.     char *buf;                /* Where to store data read. */
  484.     int bufSize;            /* How much space is available
  485.                                          * in the buffer? */
  486.     int *errorCode;            /* Where to store error code. */
  487. {
  488.     FileInfo *infoPtr;
  489.     DWORD bytesRead;
  490.  
  491.     *errorCode = 0;
  492.     infoPtr = (FileInfo *) instanceData;
  493.  
  494.     /*
  495.      * Note that we will block on reads from a console buffer until a
  496.      * full line has been entered.  The only way I know of to get
  497.      * around this is to write a console driver.  We should probably
  498.      * do this at some point, but for now, we just block.  The same
  499.      * problem exists for files being read over the network.
  500.      */
  501.  
  502.     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
  503.             (LPOVERLAPPED) NULL) != FALSE) {
  504.     return bytesRead;
  505.     }
  506.     
  507.     TclWinConvertError(GetLastError());
  508.     *errorCode = errno;
  509.     if (errno == EPIPE) {
  510.     return 0;
  511.     }
  512.     return -1;
  513. }
  514.  
  515. /*
  516.  *----------------------------------------------------------------------
  517.  *
  518.  * FileOutputProc --
  519.  *
  520.  *    Writes the given output on the IO channel. Returns count of how
  521.  *    many characters were actually written, and an error indication.
  522.  *
  523.  * Results:
  524.  *    A count of how many characters were written is returned and an
  525.  *    error indication is returned in an output argument.
  526.  *
  527.  * Side effects:
  528.  *    Writes output on the actual channel.
  529.  *
  530.  *----------------------------------------------------------------------
  531.  */
  532.  
  533. static int
  534. FileOutputProc(instanceData, buf, toWrite, errorCode)
  535.     ClientData instanceData;        /* File state. */
  536.     char *buf;                /* The data buffer. */
  537.     int toWrite;            /* How many bytes to write? */
  538.     int *errorCode;            /* Where to store error code. */
  539. {
  540.     FileInfo *infoPtr = (FileInfo *) instanceData;
  541.     DWORD bytesWritten;
  542.     
  543.     *errorCode = 0;
  544.  
  545.     /*
  546.      * If we are writing to a file that was opened with O_APPEND, we need to
  547.      * seek to the end of the file before writing the current buffer.
  548.      */
  549.  
  550.     if (infoPtr->flags & FILE_APPEND) {
  551.         SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
  552.     }
  553.  
  554.     if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
  555.             (LPOVERLAPPED) NULL) == FALSE) {
  556.         TclWinConvertError(GetLastError());
  557.         *errorCode = errno;
  558.         return -1;
  559.     }
  560.     FlushFileBuffers(infoPtr->handle);
  561.     return bytesWritten;
  562. }
  563.  
  564. /*
  565.  *----------------------------------------------------------------------
  566.  *
  567.  * FileWatchProc --
  568.  *
  569.  *    Called by the notifier to set up to watch for events on this
  570.  *    channel.
  571.  *
  572.  * Results:
  573.  *    None.
  574.  *
  575.  * Side effects:
  576.  *    None.
  577.  *
  578.  *----------------------------------------------------------------------
  579.  */
  580.  
  581. static void
  582. FileWatchProc(instanceData, mask)
  583.     ClientData instanceData;        /* File state. */
  584.     int mask;                /* What events to watch for; OR-ed
  585.                                          * combination of TCL_READABLE,
  586.                                          * TCL_WRITABLE and TCL_EXCEPTION. */
  587. {
  588.     FileInfo *infoPtr = (FileInfo *) instanceData;
  589.     Tcl_Time blockTime = { 0, 0 };
  590.  
  591.     /*
  592.      * Since the file is always ready for events, we set the block time
  593.      * to zero so we will poll.
  594.      */
  595.  
  596.     infoPtr->watchMask = mask & infoPtr->validMask;
  597.     if (infoPtr->watchMask) {
  598.     Tcl_SetMaxBlockTime(&blockTime);
  599.     }
  600. }
  601.  
  602. /*
  603.  *----------------------------------------------------------------------
  604.  *
  605.  * FileGetHandleProc --
  606.  *
  607.  *    Called from Tcl_GetChannelFile to retrieve OS handles from
  608.  *    a file based channel.
  609.  *
  610.  * Results:
  611.  *    Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
  612.  *    there is no handle for the specified direction. 
  613.  *
  614.  * Side effects:
  615.  *    None.
  616.  *
  617.  *----------------------------------------------------------------------
  618.  */
  619.  
  620. static int
  621. FileGetHandleProc(instanceData, direction, handlePtr)
  622.     ClientData instanceData;    /* The file state. */
  623.     int direction;        /* TCL_READABLE or TCL_WRITABLE */
  624.     ClientData *handlePtr;    /* Where to store the handle.  */
  625. {
  626.     FileInfo *infoPtr = (FileInfo *) instanceData;
  627.  
  628.     if (direction & infoPtr->validMask) {
  629.     *handlePtr = (ClientData) infoPtr->handle;
  630.     return TCL_OK;
  631.     } else {
  632.     return TCL_ERROR;
  633.     }
  634. }
  635.  
  636. /*
  637.  *----------------------------------------------------------------------
  638.  *
  639.  * ComInputProc --
  640.  *
  641.  *    Reads input from the IO channel into the buffer given. Returns
  642.  *    count of how many bytes were actually read, and an error indication.
  643.  *
  644.  * Results:
  645.  *    A count of how many bytes were read is returned and an error
  646.  *    indication is returned in an output argument.
  647.  *
  648.  * Side effects:
  649.  *    Reads input from the actual channel.
  650.  *
  651.  *----------------------------------------------------------------------
  652.  */
  653.  
  654. static int
  655. ComInputProc(instanceData, buf, bufSize, errorCode)
  656.     ClientData instanceData;    /* File state. */
  657.     char *buf;            /* Where to store data read. */
  658.     int bufSize;        /* How much space is available 
  659.                  * in the buffer? */
  660.     int *errorCode;        /* Where to store error code. */
  661. {
  662.     FileInfo *infoPtr;
  663.     DWORD bytesRead;
  664.     DWORD dw;
  665.     COMSTAT cs;
  666.  
  667.     *errorCode = 0;
  668.     infoPtr = (FileInfo *) instanceData;
  669.  
  670.     if (ClearCommError(infoPtr->handle, &dw, &cs)) {
  671.     if (dw != 0) {
  672.         *errorCode = EIO;
  673.         return -1;
  674.     }
  675.     if (cs.cbInQue != 0) {
  676.         if ((DWORD) bufSize > cs.cbInQue) {
  677.         bufSize = cs.cbInQue;
  678.         }
  679.     } else {
  680.         if (infoPtr->flags & FILE_ASYNC) {
  681.         errno = *errorCode = EAGAIN;
  682.         return -1;
  683.         } else {
  684.         bufSize = 1;
  685.         }
  686.     }
  687.     }
  688.     
  689.     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
  690.             (LPOVERLAPPED) NULL) == FALSE) {
  691.     TclWinConvertError(GetLastError());
  692.     *errorCode = errno;
  693.     return -1;
  694.     }
  695.     
  696.     return bytesRead;
  697. }
  698.  
  699. /*
  700.  *----------------------------------------------------------------------
  701.  *
  702.  * ComSetOptionProc --
  703.  *
  704.  *    Sets an option on a channel.
  705.  *
  706.  * Results:
  707.  *    A standard Tcl result. Also sets interp->result on error if
  708.  *    interp is not NULL.
  709.  *
  710.  * Side effects:
  711.  *    May modify an option on a device.
  712.  *
  713.  *----------------------------------------------------------------------
  714.  */
  715.  
  716. static int        
  717. ComSetOptionProc(instanceData, interp, optionName, value)
  718.     ClientData instanceData;    /* File state. */
  719.     Tcl_Interp *interp;        /* For error reporting - can be NULL. */
  720.     char *optionName;        /* Which option to set? */
  721.     char *value;        /* New value for option. */
  722. {
  723.     FileInfo *infoPtr;
  724.     DCB dcb;
  725.     int len;
  726.  
  727.     infoPtr = (FileInfo *) instanceData;
  728.  
  729.     len = strlen(optionName);
  730.     if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
  731.     if (GetCommState(infoPtr->handle, &dcb)) {
  732.         if ((BuildCommDCB(value, &dcb) == FALSE) ||
  733.             (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
  734.         /*
  735.          * one should separate the 2 errors... 
  736.          */
  737.                 if (interp) {
  738.                     Tcl_AppendResult(interp, "bad value for -mode: should be ",
  739.                 "baud,parity,data,stop", NULL);
  740.         }
  741.         return TCL_ERROR;
  742.         } else {
  743.         return TCL_OK;
  744.         }
  745.     } else {
  746.         if (interp) {
  747.         Tcl_AppendResult(interp, "can't get comm state", NULL);
  748.         }
  749.         return TCL_ERROR;
  750.     }
  751.     } else {
  752.     return Tcl_BadChannelOption(interp, optionName, "mode");
  753.     }
  754. }
  755.  
  756. /*
  757.  *----------------------------------------------------------------------
  758.  *
  759.  * ComGetOptionProc --
  760.  *
  761.  *    Gets a mode associated with an IO channel. If the optionName arg
  762.  *    is non NULL, retrieves the value of that option. If the optionName
  763.  *    arg is NULL, retrieves a list of alternating option names and
  764.  *    values for the given channel.
  765.  *
  766.  * Results:
  767.  *    A standard Tcl result. Also sets the supplied DString to the
  768.  *    string value of the option(s) returned.
  769.  *
  770.  * Side effects:
  771.  *    The string returned by this function is in static storage and
  772.  *    may be reused at any time subsequent to the call.
  773.  *
  774.  *----------------------------------------------------------------------
  775.  */
  776.  
  777. static int        
  778. ComGetOptionProc(instanceData, interp, optionName, dsPtr)
  779.     ClientData instanceData;    /* File state. */
  780.     Tcl_Interp *interp;          /* For error reporting - can be NULL. */
  781.     char *optionName;        /* Option to get. */
  782.     Tcl_DString *dsPtr;        /* Where to store value(s). */
  783. {
  784.     FileInfo *infoPtr;
  785.     DCB dcb;
  786.     int len;
  787.  
  788.     infoPtr = (FileInfo *) instanceData;
  789.  
  790.     if (optionName == NULL) {
  791.     Tcl_DStringAppendElement(dsPtr, "-mode");
  792.     len = 0;
  793.     } else {
  794.     len = strlen(optionName);
  795.     }
  796.     if ((len == 0) || 
  797.         ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
  798.     if (GetCommState(infoPtr->handle, &dcb) == 0) {
  799.         /*
  800.          * shouldn't we flag an error instead ? 
  801.          */
  802.         Tcl_DStringAppendElement(dsPtr, "");
  803.     } else {
  804.         char parity;
  805.         char *stop;
  806.         char buf[32];
  807.  
  808.         parity = 'n';
  809.         if (dcb.Parity < 4) {
  810.         parity = "noems"[dcb.Parity];
  811.         }
  812.  
  813.         stop = (dcb.StopBits == ONESTOPBIT) ? "1" : 
  814.             (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
  815.  
  816.         wsprintf(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
  817.             stop);
  818.         Tcl_DStringAppendElement(dsPtr, buf);
  819.     }
  820.     return TCL_OK;
  821.     } else {
  822.     return Tcl_BadChannelOption(interp, optionName, "mode");
  823.     }
  824. }
  825.  
  826. /*
  827.  *----------------------------------------------------------------------
  828.  *
  829.  * Tcl_OpenFileChannel --
  830.  *
  831.  *    Open an File based channel on Unix systems.
  832.  *
  833.  * Results:
  834.  *    The new channel or NULL. If NULL, the output argument
  835.  *    errorCodePtr is set to a POSIX error.
  836.  *
  837.  * Side effects:
  838.  *    May open the channel and may cause creation of a file on the
  839.  *    file system.
  840.  *
  841.  *----------------------------------------------------------------------
  842.  */
  843.  
  844. Tcl_Channel
  845. Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
  846.     Tcl_Interp *interp;            /* Interpreter for error reporting;
  847.                                          * can be NULL. */
  848.     char *fileName;            /* Name of file to open. */
  849.     char *modeString;            /* A list of POSIX open modes or
  850.                                          * a string such as "rw". */
  851.     int permissions;            /* If the open involves creating a
  852.                                          * file, with what modes to create
  853.                                          * it? */
  854. {
  855.     FileInfo *infoPtr;
  856.     int seekFlag, mode, channelPermissions;
  857.     DWORD accessMode, createMode, shareMode, flags;
  858.     char *nativeName;
  859.     Tcl_DString buffer;
  860.     DCB dcb;
  861.     Tcl_ChannelType *channelTypePtr;
  862.     HANDLE handle;
  863.  
  864.     if (!initialized) {
  865.     FileInit();
  866.     }
  867.  
  868.     mode = TclGetOpenMode(interp, modeString, &seekFlag);
  869.     if (mode == -1) {
  870.         return NULL;
  871.     }
  872.  
  873.     nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
  874.     if (nativeName == NULL) {
  875.     return NULL;
  876.     }
  877.  
  878.     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
  879.     case O_RDONLY:
  880.         accessMode = GENERIC_READ;
  881.         channelPermissions = TCL_READABLE;
  882.         break;
  883.     case O_WRONLY:
  884.         accessMode = GENERIC_WRITE;
  885.         channelPermissions = TCL_WRITABLE;
  886.         break;
  887.     case O_RDWR:
  888.         accessMode = (GENERIC_READ | GENERIC_WRITE);
  889.         channelPermissions = (TCL_READABLE | TCL_WRITABLE);
  890.         break;
  891.     default:
  892.         panic("Tcl_OpenFileChannel: invalid mode value");
  893.         break;
  894.     }
  895.  
  896.     /*
  897.      * Map the creation flags to the NT create mode.
  898.      */
  899.  
  900.     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
  901.     case (O_CREAT | O_EXCL):
  902.     case (O_CREAT | O_EXCL | O_TRUNC):
  903.         createMode = CREATE_NEW;
  904.         break;
  905.     case (O_CREAT | O_TRUNC):
  906.         createMode = CREATE_ALWAYS;
  907.         break;
  908.     case O_CREAT:
  909.         createMode = OPEN_ALWAYS;
  910.         break;
  911.     case O_TRUNC:
  912.     case (O_TRUNC | O_EXCL):
  913.         createMode = TRUNCATE_EXISTING;
  914.         break;
  915.     default:
  916.         createMode = OPEN_EXISTING;
  917.         break;
  918.     }
  919.  
  920.     /*
  921.      * If the file is being created, get the file attributes from the
  922.      * permissions argument, else use the existing file attributes.
  923.      */
  924.  
  925.     if (mode & O_CREAT) {
  926.         if (permissions & S_IWRITE) {
  927.             flags = FILE_ATTRIBUTE_NORMAL;
  928.         } else {
  929.             flags = FILE_ATTRIBUTE_READONLY;
  930.         }
  931.     } else {
  932.     flags = GetFileAttributes(nativeName);
  933.         if (flags == 0xFFFFFFFF) {
  934.         flags = 0;
  935.     }
  936.     }
  937.  
  938.     /*
  939.      * Set up the file sharing mode.  We want to allow simultaneous access.
  940.      */
  941.  
  942.     shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
  943.  
  944.     /*
  945.      * Now we get to create the file.
  946.      */
  947.  
  948.     handle = CreateFile(nativeName, accessMode, shareMode, NULL, createMode,
  949.             flags, (HANDLE) NULL);
  950.  
  951.     if (handle == INVALID_HANDLE_VALUE) {
  952.     DWORD err;
  953.  
  954.     openerr:
  955.     err = GetLastError();
  956.     if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
  957.         err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
  958.     }
  959.         TclWinConvertError(err);
  960.     if (interp != (Tcl_Interp *) NULL) {
  961.             Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
  962.                     Tcl_PosixError(interp), (char *) NULL);
  963.         }
  964.         Tcl_DStringFree(&buffer);
  965.         return NULL;
  966.     }
  967.  
  968.     dcb.DCBlength = sizeof( DCB ) ;
  969.     if (GetCommState(handle, &dcb)) {
  970.     /*
  971.      * This is a com port.  Reopen it with the correct modes. 
  972.      */
  973.  
  974.     COMMTIMEOUTS cto;
  975.  
  976.     CloseHandle(handle);
  977.     handle = CreateFile(nativeName, accessMode, 0, NULL, OPEN_EXISTING,
  978.         flags, NULL);
  979.     if (handle == INVALID_HANDLE_VALUE) {
  980.         goto openerr;
  981.     }
  982.  
  983.     /*
  984.      * FileInit the com port.
  985.      */
  986.  
  987.     SetCommMask(handle, EV_RXCHAR);
  988.     SetupComm(handle, 4096, 4096);
  989.     PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
  990.         | PURGE_RXCLEAR);
  991.     cto.ReadIntervalTimeout = MAXDWORD;
  992.     cto.ReadTotalTimeoutMultiplier = 0;
  993.     cto.ReadTotalTimeoutConstant = 0;
  994.         cto.WriteTotalTimeoutMultiplier = 0;
  995.     cto.WriteTotalTimeoutConstant = 0;
  996.     SetCommTimeouts(handle, &cto);
  997.  
  998.     GetCommState(handle, &dcb);
  999.     SetCommState(handle, &dcb);
  1000.     channelTypePtr = &comChannelType;
  1001.     } else {
  1002.     channelTypePtr = &fileChannelType;
  1003.     }
  1004.     Tcl_DStringFree(&buffer);
  1005.  
  1006.     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
  1007.     infoPtr->nextPtr = firstFilePtr;
  1008.     firstFilePtr = infoPtr;
  1009.     infoPtr->validMask = channelPermissions;
  1010.     infoPtr->watchMask = 0;
  1011.     infoPtr->flags = (mode & O_APPEND) ? FILE_APPEND : 0;
  1012.     infoPtr->handle = handle;
  1013.    
  1014.     sprintf(channelName, "file%d", (int) handle);
  1015.  
  1016.     infoPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
  1017.             (ClientData) infoPtr, channelPermissions);
  1018.  
  1019.     if (seekFlag) {
  1020.         if (Tcl_Seek(infoPtr->channel, 0, SEEK_END) < 0) {
  1021.             if (interp != (Tcl_Interp *) NULL) {
  1022.                 Tcl_AppendResult(interp, "could not seek to end of file on \"",
  1023.                         channelName, "\": ", Tcl_PosixError(interp),
  1024.                         (char *) NULL);
  1025.             }
  1026.             Tcl_Close(NULL, infoPtr->channel);
  1027.             return NULL;
  1028.         }
  1029.     }
  1030.  
  1031.     /*
  1032.      * Files have default translation of AUTO and ^Z eof char, which
  1033.      * means that a ^Z will be appended to them at close.
  1034.      */
  1035.     
  1036.     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
  1037.     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
  1038.     return infoPtr->channel;
  1039. }
  1040.  
  1041. /*
  1042.  *----------------------------------------------------------------------
  1043.  *
  1044.  * Tcl_MakeFileChannel --
  1045.  *
  1046.  *    Creates a Tcl_Channel from an existing platform specific file
  1047.  *    handle.
  1048.  *
  1049.  * Results:
  1050.  *    The Tcl_Channel created around the preexisting file.
  1051.  *
  1052.  * Side effects:
  1053.  *    None.
  1054.  *
  1055.  *----------------------------------------------------------------------
  1056.  */
  1057.  
  1058. Tcl_Channel
  1059. Tcl_MakeFileChannel(handle, mode)
  1060.     ClientData handle;        /* OS level handle */
  1061.     int mode;            /* ORed combination of TCL_READABLE and
  1062.                                  * TCL_WRITABLE to indicate file mode. */
  1063. {
  1064.     char channelName[20];
  1065.     FileInfo *infoPtr;
  1066.  
  1067.     if (!initialized) {
  1068.     FileInit();
  1069.     }
  1070.  
  1071.     if (mode == 0) {
  1072.     return NULL;
  1073.     }
  1074.  
  1075.     sprintf(channelName, "file%d", (int) handle);
  1076.  
  1077.     /*
  1078.      * See if a channel with this handle already exists.
  1079.      */
  1080.     
  1081.     for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  1082.     if (infoPtr->handle == (HANDLE) handle) {
  1083.         return (mode == infoPtr->validMask) ? infoPtr->channel : NULL;
  1084.     }
  1085.     }
  1086.  
  1087.     infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
  1088.     infoPtr->nextPtr = firstFilePtr;
  1089.     firstFilePtr = infoPtr;
  1090.     infoPtr->validMask = mode;
  1091.     infoPtr->watchMask = 0;
  1092.     infoPtr->flags = 0;
  1093.     infoPtr->handle = (HANDLE) handle;
  1094.     infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
  1095.             (ClientData) infoPtr, mode);
  1096.  
  1097.     /*
  1098.      * Windows files have AUTO translation mode and ^Z eof char on input.
  1099.      */
  1100.     
  1101.     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
  1102.     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
  1103.     return infoPtr->channel;
  1104. }
  1105.  
  1106. /*
  1107.  *----------------------------------------------------------------------
  1108.  *
  1109.  * TclGetDefaultStdChannel --
  1110.  *
  1111.  *    Constructs a channel for the specified standard OS handle.
  1112.  *
  1113.  * Results:
  1114.  *    Returns the specified default standard channel, or NULL.
  1115.  *
  1116.  * Side effects:
  1117.  *    May cause the creation of a standard channel and the underlying
  1118.  *    file.
  1119.  *
  1120.  *----------------------------------------------------------------------
  1121.  */
  1122.  
  1123. Tcl_Channel
  1124. TclGetDefaultStdChannel(type)
  1125.     int type;            /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  1126. {
  1127.     Tcl_Channel channel;
  1128.     HANDLE handle;
  1129.     int mode;
  1130.     char *bufMode;
  1131.     DWORD handleId;        /* Standard handle to retrieve. */
  1132.  
  1133.     switch (type) {
  1134.     case TCL_STDIN:
  1135.         handleId = STD_INPUT_HANDLE;
  1136.         mode = TCL_READABLE;
  1137.         bufMode = "line";
  1138.         break;
  1139.     case TCL_STDOUT:
  1140.         handleId = STD_OUTPUT_HANDLE;
  1141.         mode = TCL_WRITABLE;
  1142.         bufMode = "line";
  1143.         break;
  1144.     case TCL_STDERR:
  1145.         handleId = STD_ERROR_HANDLE;
  1146.         mode = TCL_WRITABLE;
  1147.         bufMode = "none";
  1148.         break;
  1149.     default:
  1150.         panic("TclGetDefaultStdChannel: Unexpected channel type");
  1151.         break;
  1152.     }
  1153.     handle = GetStdHandle(handleId);
  1154.  
  1155.     /*
  1156.      * Note that we need to check for 0 because Windows will return 0 if this
  1157.      * is not a console mode application, even though this is not a valid
  1158.      * handle. 
  1159.      */
  1160.  
  1161.     if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
  1162.     return NULL;
  1163.     }
  1164.  
  1165.     channel = Tcl_MakeFileChannel(handle, mode);
  1166.  
  1167.     /*
  1168.      * Set up the normal channel options for stdio handles.
  1169.      */
  1170.  
  1171.     if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
  1172.             "auto") == TCL_ERROR)
  1173.         || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
  1174.             "\032 {}") == TCL_ERROR)
  1175.         || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
  1176.             "-buffering", bufMode) == TCL_ERROR)) {
  1177.         Tcl_Close((Tcl_Interp *) NULL, channel);
  1178.         return (Tcl_Channel) NULL;
  1179.     }
  1180.     return channel;
  1181. }
  1182.